home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-op.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-07  |  8.9 KB  |  368 lines
  1. /*  $Id: pl-op.c,v 1.16 1997/08/07 07:58:18 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: operator functions and declarations
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. forwards int    atomToOperatorType(atom_t);
  13. forwards atom_t    operatorTypeToAtom(int);
  14.  
  15. #define operatorTable (GD->op.table)
  16.  
  17. /*  Find an operator in the table. Type is one of OP_PREFIX, OP_INFIX or
  18.     op_POSTFIX.
  19.  
  20.  ** Wed Apr 20 10:34:55 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  21.  
  22. Operator
  23. isCurrentOperator(atom_t name, int type)
  24. { register int v = pointerHashValue(name, OPERATORHASHSIZE);
  25.   register Operator op;
  26.  
  27.   for(op=operatorTable[v]; op && !isTableRef(op); op=op->next)
  28.   { if (op->name != name)
  29.       continue;
  30.     if (op->priority <= 0 )
  31.       continue;
  32.     switch(op->type)
  33.     { case OP_FX:
  34.       case OP_FY:    if (type == OP_PREFIX)
  35.               return op;
  36.             continue;
  37.       case OP_XF:
  38.       case OP_YF:    if (type == OP_POSTFIX)
  39.               return op;
  40.             continue;
  41.       case OP_XFX:
  42.       case OP_XFY:
  43.       case OP_YFX:
  44.       case OP_YFY:    if (type == OP_INFIX)
  45.               return op;
  46.             continue;
  47.     }
  48.   }
  49.  
  50.   return (Operator) NULL;
  51. }
  52.  
  53.  
  54. static int
  55. atomToOperatorType(atom_t atom)
  56. { if (atom == ATOM_fx)            return OP_FX;
  57.   else if (atom == ATOM_fy)        return OP_FY;
  58.   else if (atom == ATOM_xfx)        return OP_XFX;
  59.   else if (atom == ATOM_xfy)        return OP_XFY;
  60.   else if (atom == ATOM_yfx)        return OP_YFX;
  61.   else if (atom == ATOM_yfy)        return OP_YFY;
  62.   else if (atom == ATOM_yf)        return OP_YF;
  63.   else if (atom == ATOM_xf)        return OP_XF;
  64.  
  65.   return -1;
  66. }
  67.  
  68. static atom_t
  69. operatorTypeToAtom(int type)
  70. { switch(type)
  71.   { case OP_FX:                return ATOM_fx;
  72.     case OP_FY:                return ATOM_fy;
  73.     case OP_XFX:            return ATOM_xfx;
  74.     case OP_XFY:            return ATOM_xfy;
  75.     case OP_YFX:            return ATOM_yfx;
  76.     case OP_YFY:            return ATOM_yfy;
  77.     case OP_YF:                return ATOM_yf;
  78.     case OP_XF:                return ATOM_xf;
  79.   }
  80.   return NULL_ATOM;
  81. }
  82.  
  83. word
  84. pl_current_op(term_t prec, term_t type, term_t name, word h)
  85. { int Prec = 0;                    /* not specified */
  86.   int Type = -1;                /* not specified */
  87.   atom_t Name = NULL_ATOM;            /* not specified */
  88.   Operator op;
  89.   atom_t a;
  90.  
  91.   switch( ForeignControl(h) )
  92.   { case FRG_FIRST_CALL:
  93.       op = operatorTable[0];
  94.       break;
  95.     case FRG_REDO:
  96.       op = ForeignContextPtr(h);
  97.       break;
  98.     case FRG_CUTTED:
  99.     default:
  100.       succeed;
  101.   }
  102.  
  103.   if ( !PL_get_integer(prec, &Prec) &&
  104.        !PL_is_variable(prec) )
  105.     fail;
  106.  
  107.   if ( PL_get_atom(type, &a) )
  108.   { if ( (Type = atomToOperatorType(a)) < 0 )
  109.       fail;
  110.   } else if ( !PL_is_variable(type))
  111.     fail;
  112.  
  113.   if ( !PL_get_atom(name, &Name) &&
  114.        !PL_is_variable(name) )
  115.     fail;
  116.  
  117.   for( ; op; op = op->next )
  118.   { while(isTableRef(op))
  119.     { op = unTableRef(Operator, op);
  120.       if ( !op )
  121.     fail;
  122.     }
  123.     if ( Name && Name != op->name )
  124.       continue;
  125.     if ( Type >= 0 && Type != op->type  )
  126.       continue;
  127.     if ( Prec > 0 && Prec != op->priority )
  128.       continue;
  129.     if ( op->priority <= 0 )
  130.       continue;
  131.  
  132.     if ( !PL_unify_atom(name, op->name) ||
  133.      !PL_unify_atom(type, operatorTypeToAtom(op->type)) ||
  134.      !PL_unify_integer(prec, op->priority) )
  135.       fail;
  136.  
  137.     if ( Name && Type >=0 )
  138.       succeed;
  139.  
  140.     return_next_table(Operator, op, ;);
  141.   }
  142.  
  143.   fail;
  144. }
  145.  
  146. /*  The following three functions check whether an atom is declared as
  147.     an operator. 'type' and 'priority' are integer pointers. Their
  148.     value is filled with the corresponding definition of the operator.
  149.  
  150.  ** Sun Apr 17 13:25:17 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  151.  
  152. bool
  153. isPrefixOperator(atom_t atom, int *type, int *priority)
  154. { register Operator op;
  155.  
  156.   if ((op = isCurrentOperator(atom, OP_PREFIX)) != (Operator) NULL)
  157.   { if (op->priority != 0)
  158.     { *priority = op->priority;
  159.       *type = op->type;
  160.  
  161.       succeed;
  162.     }
  163.   }
  164.  
  165.   fail;
  166. }
  167.  
  168. bool
  169. isPostfixOperator(atom_t atom, int *type, int *priority)
  170. { Operator op;
  171.  
  172.   if ((op = isCurrentOperator(atom, OP_POSTFIX)) != (Operator) NULL)
  173.   { if (op->priority != 0)
  174.     { *priority = op->priority;
  175.       *type = op->type;
  176.  
  177.       succeed;
  178.     }
  179.   }
  180.  
  181.   fail;
  182. }
  183.  
  184. bool
  185. isInfixOperator(atom_t atom, int *type, int *priority)
  186. { Operator op;
  187.  
  188.   if ((op = isCurrentOperator(atom, OP_INFIX)) != (Operator) NULL)
  189.   { if (op->priority != 0)
  190.     { *priority = op->priority;
  191.       *type = op->type;
  192.  
  193.       succeed;
  194.     }
  195.   }
  196.  
  197.   fail;
  198. }
  199.  
  200. /*  Declare a new operator. 'f' is a functor definition pointer, 'type'
  201.     if one of OP_FX, ... and 'priority' is the priority (0-1200].
  202.  
  203.  ** Sun Apr 17 13:24:04 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  204.  
  205. static bool
  206. operator(atom_t name, int type, int priority)
  207. { Operator op = (Operator) NULL;
  208.  
  209.   switch(type)
  210.   { case OP_FX:
  211.     case OP_FY:        op = isCurrentOperator(name, OP_PREFIX);
  212.             break;
  213.     case OP_XF:
  214.     case OP_YF:        op = isCurrentOperator(name, OP_POSTFIX);
  215.             break;
  216.     default:        op = isCurrentOperator(name, OP_INFIX);
  217.             break;
  218.   }
  219.  
  220.   if ( !op )
  221.   { int v;
  222.  
  223.     v = pointerHashValue(name, OPERATORHASHSIZE);
  224.     op = (Operator) allocHeap(sizeof(struct operator));
  225.     op->next = operatorTable[v];
  226.     operatorTable[v] = op;
  227.     op->name = name;
  228.   }
  229.   op->priority = priority;
  230.   op->type = type;
  231.  
  232.   succeed;
  233. }
  234.  
  235. word
  236. pl_op1(term_t priority, term_t type, term_t name)
  237. { atom_t nm;
  238.   atom_t tp;
  239.   int t;
  240.   int pri;
  241.  
  242.   if ( !PL_get_atom(name, &nm) ||
  243.        !PL_get_atom(type, &tp) ||
  244.        !PL_get_integer(priority, &pri) ||
  245.        pri < 0 || pri > OP_MAXPRIORITY ||
  246.        (t = atomToOperatorType(tp)) < 0 )
  247.     fail;
  248.  
  249.   return operator(nm, t, pri);
  250. }
  251.  
  252. /*  Define standard system operators.
  253.  
  254.  ** Sun Apr 17 13:25:40 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  255.  
  256. bool
  257. newOp(char *name, int type, int pri)
  258. { return operator(lookupAtom(name), type, pri);
  259. }
  260.  
  261. typedef struct
  262. { atom_t name;
  263.   char   type;
  264.   short  priority;
  265. } opdef;
  266.  
  267. #define OP(a, t, p) { a, t, p }
  268.  
  269. static const opdef operators[] = {
  270.   OP(ATOM_star,        OP_YFX,        400),        /* * */
  271.   OP(ATOM_plus,        OP_FX,        500),        /* + */
  272.   OP(ATOM_plus,        OP_YFX,        500),
  273.   OP(ATOM_comma,    OP_XFY,           1000),        /* , */
  274.   OP(ATOM_minus,    OP_FX,        500),        /* - */
  275.   OP(ATOM_minus,    OP_YFX,        500),
  276.   OP(ATOM_grammar,    OP_XFX,           1200),        /* --> */
  277.   OP(ATOM_ifthen,    OP_XFY,           1050),        /* -> */
  278.   OP(ATOM_softcut,    OP_XFY,           1050),        /* *-> */
  279.   OP(ATOM_divide,    OP_YFX,        400),        /* / */
  280.   OP(ATOM_div,        OP_YFX,        400),        /* // */
  281.   OP(ATOM_and,        OP_YFX,        500),        /* /\ */
  282.   OP(ATOM_module,    OP_XFY,        600),        /* : */
  283.   OP(ATOM_prove,    OP_FX,           1200),        /* :- */
  284.   OP(ATOM_prove,    OP_XFX,           1200),
  285.   OP(ATOM_semicolon,    OP_XFY,           1100),        /* ; */
  286.   OP(ATOM_bar,        OP_XFY,           1100),        /* | */
  287.   OP(ATOM_smaller,    OP_XFX,        700),        /* < */
  288.   OP(ATOM_lshift,    OP_YFX,        400),        /* << */
  289.   OP(ATOM_equals,    OP_XFX,        700),        /* = */
  290.   OP(ATOM_univ,        OP_XFX,        700),        /* =.. */
  291.   OP(ATOM_ar_equals,    OP_XFX,        700),        /* =:= */
  292.   OP(ATOM_smaller_equal,OP_XFX,        700),        /* =< */
  293.   OP(ATOM_larger_equal,    OP_XFX,        700),        /* >= */
  294.   OP(ATOM_strick_equal,    OP_XFX,        700),        /* == */
  295.   OP(ATOM_ar_not_equal,    OP_XFX,        700),        /* =\= */
  296.   OP(ATOM_larger,    OP_XFX,        700),        /* > */
  297.   OP(ATOM_rshift,    OP_YFX,        400),        /* >> */
  298.   OP(ATOM_obtain,    OP_FX,        500),        /* ? */
  299.   OP(ATOM_query,    OP_FX,           1200),        /* ?- */
  300.   OP(ATOM_at_smaller,    OP_XFX,        700),        /* @< */
  301.   OP(ATOM_at_smaller_eq,OP_XFX,        700),        /* @=< */
  302.   OP(ATOM_at_larger,    OP_XFX,        700),        /* @> */
  303.   OP(ATOM_at_larger_eq,    OP_XFX,        700),        /* @>= */
  304.   OP(ATOM_backslash,    OP_FX,        500),        /* \ */
  305.   OP(ATOM_not_provable,    OP_FY,        900),        /* \+ */
  306.   OP(ATOM_or,        OP_YFX,        500),        /* \/ */
  307.   OP(ATOM_not_equals,    OP_XFX,        700),        /* \= */
  308.   OP(ATOM_not_strickt_equals,OP_XFX,    700),        /* \== */
  309.   OP(ATOM_at_equals,    OP_XFX,        700),        /* =@= */
  310.   OP(ATOM_at_not_equals,OP_XFX,        700),        /* \=@= */
  311.   OP(ATOM_hat,        OP_XFY,        200),        /* ^ */
  312.   OP(ATOM_doublestar,    OP_XFX,        200),         /* ** */
  313.   OP(ATOM_discontiguous,OP_FX,           1150),        /* discontiguous */
  314.   OP(ATOM_dynamic,    OP_FX,           1150),        /* dynamic */
  315.   OP(ATOM_volatile,    OP_FX,           1150),         /* volatile */
  316.   OP(ATOM_initialization,OP_FX,           1150),         /* initialization */
  317.   OP(ATOM_is,        OP_XFX,        700),        /* is */
  318.   OP(ATOM_mod,        OP_YFX,        400),        /* mod */
  319.   OP(ATOM_rem,        OP_YFX,        400),        /* rem */
  320.   OP(ATOM_module_transparent,OP_FX,    1150),        /* module_transparent */
  321.   OP(ATOM_multifile,    OP_FX,           1150),        /* multifile */
  322.   OP(ATOM_not,        OP_FY,        900),        /* not */
  323.   OP(ATOM_xor,        OP_YFX,        400),        /* xor */
  324. /*OP(ATOM_tilde,    OP_FX,        900),*/        /* ~ */
  325.  
  326.   OP(NULL_ATOM,        0,        0)
  327. };
  328.  
  329.  
  330. void
  331. initOperators(void)
  332. { { Operator *op;
  333.     int n;
  334.  
  335.     for(n=0, op=operatorTable; n < (OPERATORHASHSIZE-1); n++, op++)
  336.       *op = makeTableRef(op+1);
  337.  
  338.     *op = NULL;
  339.   }
  340.  
  341.   { const opdef *op;
  342.  
  343.     for( op = operators; op->name; op++ )
  344.       operator(op->name, op->type, op->priority);
  345.   }
  346. }
  347.  
  348.  
  349. word
  350. pl_reset_operators()
  351. { int n;
  352.  
  353.   for(n=0; n<OPERATORHASHSIZE; n++)
  354.   { Operator op = operatorTable[n];
  355.     Operator next;
  356.  
  357.     for( ; op && !isTableRef(op); op = next )
  358.     { next = op->next;
  359.  
  360.       freeHeap(op, sizeof(*op));
  361.     }
  362.   }
  363.  
  364.   initOperators();
  365.  
  366.   succeed;
  367. }
  368.